home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / chrchpr2.arc / CSELCHNG.CMD < prev    next >
Encoding:
Text File  |  1979-12-31  |  5.0 KB  |  150 lines
  1. * Program CSELCHNG - Changes or Deletes lodging Room/Bed assignments.
  2. * Called by CSELODGE from selecting 3-C or 3-D                        CSEVENTS
  3. * By Rod Williams; WaterWares, March, 1985.
  4.      Store xsel+'      ' to xsel
  5.      Store $(xsel,2,5) to inbed
  6.      If inbed='     '
  7.        Accept 'Enter a Room/Bed assignment ' to inbed
  8.        Store inbed+'    ' to inbed
  9.        Store $(inbed,1,5) to inbed
  10.      endif
  11.      If !(inbed)<>'Q    ' .and.inbed<>'     '
  12.        Select secondary
  13.        Store sfield+inbed to infind
  14.        Find &infind
  15.        If #=0
  16.          ? 'Room/Bed is not found.'
  17.        else
  18.          Store $(spact,15,11) to nfind
  19.          Store trim($(spact,27,10)) to ffind
  20.          Store str(#,5) to oldrec
  21.          Select primary
  22.          Store F to nfound
  23.          If NFIND<>'           '
  24.          Find &NFIND
  25.          If #<>0
  26.            Do while last:name=nfind .and. first:name<>ffind.and. .not. EOF
  27.              SKIP
  28.            enddo
  29.            If last:name=nfind.and. first:name=ffind
  30.              Store T to nfound
  31.            endif
  32.          endif
  33.          endif
  34.          If nfound
  35.            Store nfind+' '+ffind to nfind
  36.            Store 'for '+nfind to nnfind
  37.          else
  38.            Store '                 ' to nnfind
  39.          endif
  40.          If !(xsel)='D'
  41.            ? 'Now deleting -',nfind,' ... ',$(S.spact,1,14)
  42.              If nfound
  43.                Replace room with ' '
  44.              endif
  45.              Select secondary
  46.              Replace spact with infind
  47.              Accept 'Do you want to delete the Room/Bed code too? ' to xx
  48.              If !(xx)='Y'
  49.                ? 'NOW DELETED   -   ',spact
  50.                Replace spact with $(spact,1,8)+'.'
  51.                DELETE
  52.                Store II-1 to II
  53.              endif
  54.          else
  55.             If nfound
  56.              Store F to chold
  57.              If ROOM=$(infind,6,9) .or.ROOM='         '
  58.                Store T to chold
  59.              else
  60.  ? 'The Room/Bed assignment in MEMBERSE does not match for this person.'
  61.               Store sfield+$(room,5,5) to xx
  62.               Select secondary
  63.               Find &XX
  64.               If #<>0
  65.                 ? 'The Name is cleared in the EDIRFILE.  '
  66.                 GOTO &oldrec
  67.                 Replace spact with $(spact,1,14)
  68.               else
  69.                 ? "This person's Room/Bed is being re-assigned."
  70.                 Store T to CHOLD
  71.               endif
  72.              endif
  73.              If CHOLD
  74.                Accept 'Enter a new Room/Bed assignment ' to inbed
  75.                Store inbed+'    ' to inbed
  76.                If !(inbed)<>'Q    ' .and. inbed<>'     '
  77.                 Store sfield+$(inbed,1,5) to xx
  78.                 Store T to RBCHANGE
  79.                 Store F to RBAPPEND
  80.                 Store sfield to sfieldx
  81.                 Select secondary
  82.                 If len(trim(inbed)) > 5
  83.                   Store 'ROOM='+$(inbed,1,3)+' ' to xx
  84.                   Find &xx
  85.                   If #=0
  86. ? 'This different LODGING name, "',$(inbed,1,3),'" not found. No change made.'
  87.                     Store F to RBCHANGE
  88.                   else
  89.                     Store xx  to sfieldx
  90.                     Store $(inbed,5,5) to inbed
  91.                     Store sfieldx+inbed to xx
  92.                     Find &xx
  93.                   endif
  94.                 else
  95.                   Store $(inbed,1,5) to inbed
  96.                   Find &xx
  97.                 endif
  98.                 If RBCHANGE
  99.                 If #<>0
  100.                  If $(spact,15,10)<>'         '
  101.                    ? 'This Room/Bed is already assigned. No change is made.'
  102.                  Store F to RBCHANGE
  103.                  else
  104.                   Store str(#,5) to newrec
  105.                  endif
  106.                 else
  107.                  Store T to RBappend
  108.                 endif
  109.                 endif
  110.                 If RBCHANGE
  111.                    ? 'Now replacing',infind,'with',sfieldx,inbed,nnfind
  112.                    Select primary
  113.                    Replace room with $(sfieldx,6,4)+inbed
  114.                    Select secondary
  115.                    GOTO &oldrec
  116.                    Replace spact with $(spact,1,14)
  117.                    If RBAPPEND
  118.                      Append blank
  119.                      If $(sfieldx,6,4)=$(sfield,6,4)
  120.                        Store II+1 to II
  121.                      endif
  122.                    else
  123.                      GOTO &newrec
  124.                    endif
  125.                    Replace spact with sfieldx+inbed+nfind
  126.                 endif  * RBCHANGE
  127.                endif
  128.              endif
  129.             else
  130.              Set raw on
  131. ? 'Name "',nfind,ffind,'" is not found in MEMBERSE. Now cleared from EDIRFILE.'
  132.              Set raw off
  133.              Select secondary
  134.              GOTO &OLDREC
  135.              Replace spact with $(spact,1,14)
  136.             endif
  137.            endif
  138.        endif  * #=0
  139.     endif
  140.     Store 'C' to xsel
  141. RETURN
  142.  
  143. l
  144. RETURN
  145.  
  146. to inbed
  147.      endif
  148.      If !(inbed)<>'Q    ' .and.inbed<>'     '
  149.        Select secondary
  150.        Store sf